Visual Basic 5 Developer's Kit/vb5 dev kit.iso/dev/tcp4w20/samples/pascal/pwlpq.pas

Pascal/Delphi Source File | 1996-06-10 | 4.7 KB | 206 lines

Program PWTN;
{$A+,B-,D+,F-,G+,I-,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
{$M 8192,8192}
{Simple LPQ (Line Printer Queue) Client for TCP4W}
{See RFC 1179 for LPQ-Definitions}

Uses WinTypes, WinProcs, WinCrt, Strings, UseTcp4w;

Const TIL = 255;

Type PTextItem = ^TTextItem;
     TTextItem = Array [0..TIL] of Char;

Var Status: Integer;
    S: TSocket;
    Port: Integer;
    H: String;
    PrinterIP: Array [0..80] Of Char;
    T: TTextItem;
    IP: TIP;
    F: File;
    SaveExitProc: Pointer;

Procedure WriteWinsockVerInfo;
  Const WSADESCRIPTION_LEN = 256;
        WSASYS_STATUS_LEN = 128;
  Type TWSAData = Record
           wVersion: Word;
           wHighVersion: Word;
           szDescription: Array [0..WSADESCRIPTION_LEN] Of Char;
           szSystemStatus: Array [0..WSASYS_STATUS_LEN] Of Char;
           iMaxSockets: Byte;
           iMaxUdpDg: Byte;
           lpVendorInfo: Pointer;
         End;
       TWSAStartUp = Function (wVersionRequested: Word; WSAData: TWSAData): Integer;
       TWSACleanup = Function: Integer;
  Var WSAData: TWSAData;
      hWinsock: THandle;
      FP : TFarProc;
  Begin
    hWinsock := LoadLibrary ('WINSOCK');
    If hWinsock >= 32 Then
      Begin
        FP := GetProcAddress (hWinsock, 'WSAStartup');
        If FP <> NIL Then
          If TWSAStartUp (FP) (257, WSAData) = 0 Then
            WriteLn (WSAData.szDescription);
        FP := GetProcAddress (hWinsock, 'WSACleanup');
        If FP <> NIL Then TWSACleanUp (FP);
        FreeLibrary (hWinsock)
      End
  End;

Procedure CheckIO;
  Begin
    If IOResult = 0 Then Exit;
    WriteLn;
    WriteLn ('File-Error.');
    Halt
  End;

Procedure CheckStatus;
  Begin
    If Status > 0 Then Exit;
    WriteLn;
    WriteLn ('?', Tcp4W_Error (Status));
    Halt
  End;

Procedure PrinterAnswer;
  Var I: Word;
  Begin
    Status := TcpRecv (S, T, TIL, 10, -1);
    If Status > 0 Then T[Status] := #0;
    If (Status = IP_EmptyBuffer) Then Exit;
    CheckStatus;
    If StrLen (T) > 0 Then
      Begin
        WriteLn;
        WriteLn ('Printer-Error.');
        Halt
      End;
  End;

Procedure TypeFile;
  Var L: LongInt;
  Begin
    L := FileSize (F);
    While L > TIL Do
      Begin
        BlockRead (F, T, TIL);
        CheckIO;
        Status := TCPSend (S, T, TIL, False, -1);
        CheckStatus;
        L := L - TIL;
        Write ('.');
      End;
    If L = 0 Then Exit;
    BlockRead (F, T, L);
    CheckIO;
    Status := TCPSend (S, T, L, False, -1);
    CheckStatus
  End;

Procedure MyExitProc; Far;
  Begin
    ExitProc := SaveExitProc;
    If S <> 0 Then TcpClose (S);
    Tcp4wCleanUp;
  End;

Begin
  CmdShow := sw_ShowMaximized;
  AutoTracking := False;
  WriteLn ('Simple lpq Client by AStA ([e-mail]) <Polarwolf>');

  S := 0;
  Port := 515;
  Status := Tcp4wInit;
  CheckStatus;
  SaveExitProc := ExitProc;
  ExitProc := @MyExitProc;

  Tcp4wVer (T, TIL);
  WriteLn (T);
  WriteWinsockVerInfo;

  WriteLn;
  Write ('Printer-IP:');
  ReadLn (PrinterIP);
  If StrLen (PrinterIP) = 0 Then Halt;

  Status := TcpConnect (S, PrinterIP, '', Port);
  CheckStatus;
  WriteLn ('Socket: ', S, '  Port: ', Port);
  Status := TcpGetRemoteID (S, T, TIL, IP);
  CheckStatus;
  WriteLn ('Remote Printer: ', T, ' (', IP.B1, '.', IP.B2, '.',
    IP.B3, '.', IP.B4, ')');

  StrPCopy (T, #2'AStA'#10);
  Status := TCPSend (S, T, StrLen (T), False, -1);
  CheckStatus;
  PrinterAnswer;

  StrPCopy (T, #2'2 cfA004'#10);
  Status := TCPSend (S, T, StrLen (T), False, -1);
  CheckStatus;
  PrinterAnswer;

  StrPCopy (T, 'o'#10#0);
  Status := TCPSend (S, T, StrLen (T)+1, False, -1);
  CheckStatus;
  PrinterAnswer;

  TcpClose (S);
  S := 0;
  CheckStatus;

  Status := TcpConnect (S, PrinterIP, '', Port);
  CheckStatus;

  StrPCopy (T, #2'AStA'#10);
  Status := TCPSend (S, T, StrLen (T), False, -1);
  PrinterAnswer;

  WriteLn;
  Write ('Postscipt-Filename:');
  ReadLn (H);
  If Length (H) = 0 Then Halt;
  Assign (F, H);
  Reset (F, 1);
  CheckIO;
  Str (FileSize (F), H);
  CheckIO;
  If H [1] = ' ' Then H := Copy (H, 2, 255);
  StrPCopy (T, #3+H+' dfA004'#10);
  Status := TCPSend (S, T, StrLen (T), False, -1);
  CheckStatus;
  TypeFile;
  StrPCopy (T, #0);
  Status := TCPSend (S, T, 1, False, -1);
  CheckStatus;
  PrinterAnswer;

  Close (F);
  CheckIO;
  TcpClose (S);
  S := 0;
  CheckStatus;

  Status := TcpConnect (S, PrinterIP, '', Port);
  CheckStatus;

  StrPCopy (T, #1'AStA'#10#0);
  Status := TCPSend (S, T, StrLen (T)+1, False, -1);
  PrinterAnswer;
  TcpClose (S);
  S := 0;
  CheckStatus;

  WriteLn;
  WriteLn ('OK');
End.